perm filename TRIANG.IL0[TIM,LSP] blob sn#736741 filedate 1983-12-28 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(FILECREATED "30-MAY-83 15:25:29" {PHYLUM}<GABRIEL>TRIANG.5 3271   
C00008 ENDMK
C⊗;
(FILECREATED "30-MAY-83 15:25:29" {PHYLUM}<GABRIEL>TRIANG.;5 3271   

      CHANGES TO:  (VARS TRIANGCOMS)
		   (FNS LAST-POSITION TRY TEST TRIANG-INIT GOGOGO)

      PREVIOUS DATE: "30-MAY-83 13:50:41" {PHYLUM}<GABRIEL>TRIANG.;1)


(* COPYRIGHT (C) 1983 BY BOZOB CORPORATION)

(PRETTYCOMPRINT TRIANGCOMS)

(RPAQQ NTRIANGCOMS ((LOCALVARS . T)
		   (SPECVARS ANSWER FINAL DEEPCOUNTER)
		   (GLOBALVARS BOARD SEQUENCE A B C)
		   (FNS GOGOGO LAST-POSITION TRY TEST TRIANG-INIT)
		   (BLOCKS 
		    (NTRIANGBLOCK
		     GOGOGO LAST-POSITION TRY TEST TRIANG-INIT
		     (ENTRIES GOGOGO TRIANG-INIT TEST)))
		   (P (TRIANG-INIT))))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(SPECVARS ANSWER FINAL DEEPCOUNTER)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS BOARD SEQUENCE A B C)
)
(DEFINEQ

(GOGOGO
  (LAMBDA (I)                                                (* JONL "30-MAY-83 13:48")
    (PROG ((ANSWER NIL)
	   (FINAL NIL))
          (RETURN (TRY I 1)))))

(LAST-POSITION
  (LAMBDA NIL                                                (* JONL "30-MAY-83 15:22")
    (OR (FIND I TO 16 SUCHTHAT (EQ 1 (ELT BOARD I)))
	0)))

(TRY
  (LAMBDA (I DEPTH)                                          (* JONL "30-MAY-83 15:18")
    (DECLARE (SPECVARS ANSWER FINAL)
	     (GLOBALVARS BOARD SEQUENCE A B C))
    (COND
      ((EQ DEPTH 14)
	(PROG ((LP (LAST-POSITION)))
	      (COND
		((MEMBER LP FINAL))
		(T (PUSH FINAL LP))))
	(BIND (Q ← NIL) FOR J FROM 1 TO 14 DO (PUSH Q (ELT SEQUENCE J))
	      FINALLY (PUSH Q ANSWER))
	T)
      ((AND (EQ 1 (ELT BOARD (ELT A I)))
	    (EQ 1 (ELT BOARD (ELT B I)))
	    (EQ 0 (ELT BOARD (ELT C I))))
	(SETA BOARD (ELT A I) 0)
	(SETA BOARD (ELT B I) 0)
	(SETA BOARD (ELT C I) 1)
	(SETA SEQUENCE DEPTH I)
	(BIND (DEPTH ←(ADD1 DEPTH)) FOR J FROM 1 TO 37 UNTIL (TRY J DEPTH) DO NIL)
	(SETA BOARD (ELT A I) 1)
	(SETA BOARD (ELT B I) 1)
	(SETA BOARD (ELT C I) 0)
	NIL))))

(TEST
  (LAMBDA NIL                                                (* JONL "30-MAY-83 15:18")
    (DECLARE (SPECVARS ANSWER FINAL)
	     (GLOBALVARS BOARD SEQUENCE A B C))
    (TRIANG-INIT)
    (PROG ((ANSWER NIL)
	   (FINAL NIL))
          (TRY 23 1)
          (RETURN (EQ 775 (LENGTH ANSWER))))))

(TRIANG-INIT
  (LAMBDA NIL                                                (* JONL "30-MAY-83 15:00")
    (SETQ BOARD (ARRAY 17))
    (FOR I FROM 1 TO 16 DO (SETA BOARD I 1))
    (SETA BOARD 5 0)
    (SETQ SEQUENCE (ARRAY 15))
    (SETQ A
      (ARRAY 38))
    (BIND (K ← 1) FOR J IN
		 (QUOTE (1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4 7 11 8 12 13 6 10 15 9 14 13 13 14 
			   15 9 10 6 0))  DO
			   (SETA A K J)(SETQ K (ADD1 K)))
    (SETQ B
      (ARRAY 38))
    (BIND (K ← 1) FOR J IN
		 (QUOTE (2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5 2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 
			   9 5 0)) DO
			   (SETA B K J)(SETQ K (ADD1 K)))
    (SETQ C
      (ARRAY 38))
    (BIND (K ← 1) FOR J IN
		 (QUOTE (4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6 1 2 4 3 5 6 1 3 6 2 5 4 11 12 
			   13 7 8 4 0)) DO
		 (SETA C K J)(SETQ K (ADD1 K)))))
)
(PUTPROPS TRIANG COPYRIGHT ("XEROX CORPORATION" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (714 3180 (GOGOGO 724 . 904) (LAST-POSITION 906 . 1089) (TRY 1091 . 1886) (TEST 1888 . 
2206) (TRIANG-INIT 2208 . 3178)))))
STOP